home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / generic.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  21.3 KB  |  718 lines
  1. ;;;
  2. ;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
  3. ;;;
  4. ;;; All rights reserved.
  5. ;;;
  6. ;;; Redistribution and use in source and binary forms, with or without
  7. ;;; modification, are permitted provided that the following conditions
  8. ;;; are met:
  9. ;;; 1. Redistributions of source code must retain the above copyright
  10. ;;;    notice, this list of conditions and the following disclaimer.
  11. ;;; 2. Redistributions in binary form must reproduce the above copyright
  12. ;;;    notice, this list of conditions and the following disclaimer in the
  13. ;;;    documentation and/or other materials provided with the distribution.
  14. ;;; 3. Neither the name of authors nor the names of its contributors
  15. ;;;    may be used to endorse or promote products derived from this software
  16. ;;;    without specific prior written permission.
  17. ;;;
  18. ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
  19. ;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  20. ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  21. ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
  22. ;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  23. ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  24. ;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  25. ;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  26. ;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  27. ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  28. ;;; SUCH DAMAGE.
  29. ;;;;
  30.  
  31. (require "util.scm")
  32. (require "rk.scm")
  33. (require-custom "generic-key-custom.scm")
  34. (require-custom "generic-custom.scm")
  35.  
  36.  
  37. ;; widgets and actions
  38.  
  39. ;; widgets
  40. (define generic-widgets '(widget_generic_input_mode))
  41.  
  42. ;; default activity for each widgets
  43. (define default-widget_generic_input_mode 'action_generic_off)
  44.  
  45. ;; actions of widget_generic_input_mode
  46. (define generic-input-mode-actions
  47.   '(action_generic_off
  48.     action_generic_on))
  49.  
  50.  
  51. ;;; implementations
  52.  
  53. (define ascii-rule
  54.   (map (compose (lambda (entry)
  55.           (list (list entry) entry))
  56.         list
  57.         charcode->string)
  58.        (iota 95 32)))
  59.  
  60. (define generic-prepare-activation
  61.   (lambda (gc)
  62.     (let ((rkc (generic-context-rk-context gc)))
  63.       (rk-flush rkc)
  64.       (generic-update-preedit gc))))
  65.  
  66. (register-action 'action_generic_off
  67.          (lambda (gc)
  68.            (list
  69.             'off
  70.             "-"
  71.             (N_ "off")
  72.             (N_ "Direct Input Mode")))
  73.          (lambda (gc)
  74.            (not (generic-context-on gc)))
  75.          (lambda (gc)
  76.            (generic-prepare-activation gc)
  77.            (generic-context-set-on! gc #f)))
  78.  
  79. (register-action 'action_generic_on
  80.          (lambda (gc)
  81.            (let* ((im (generic-context-im gc))
  82.               (name (symbol->string (im-name im))))
  83.              (list
  84.               'on
  85.               "O"
  86.               (N_ "on")
  87.               (string-append name (N_ " Mode")))))
  88.          (lambda (gc)
  89.            (generic-context-on gc))
  90.          (lambda (gc)
  91.            (generic-prepare-activation gc)
  92.            (generic-context-set-on! gc #t)))
  93.  
  94. ;; Update widget definitions based on action configurations. The
  95. ;; procedure is needed for on-the-fly reconfiguration involving the
  96. ;; custom API
  97. (define generic-configure-widgets
  98.   (lambda ()
  99.     (register-widget 'widget_generic_input_mode
  100.              (activity-indicator-new generic-input-mode-actions)
  101.              (actions-new generic-input-mode-actions))))
  102.  
  103. (define generic-context-rec-spec
  104.   (append
  105.    context-rec-spec
  106.    '((rk-context            #f)
  107.      (rk-nth                0)
  108.      (on                    #f)
  109.      (candidate-op-count    0)
  110.      (raw-commit            #f)
  111.      (converting            #f)
  112.      (multi-cand-input      #f)
  113.      (cands                 ()))))
  114. (define-record 'generic-context generic-context-rec-spec)
  115. (define generic-context-new-internal generic-context-new)
  116.  
  117. (define generic-context-new
  118.   (lambda (id im rule back)
  119.     (let ((gc (generic-context-new-internal id im))
  120.       (rkc (rk-context-new rule #f back)))
  121.       (generic-context-set-widgets! gc generic-widgets)
  122.       (generic-context-set-rk-context! gc rkc)
  123.       gc)))
  124.  
  125. (define generic-context-flush
  126.   (lambda (pc)
  127.     (generic-context-set-rk-nth! pc 0)
  128.     (generic-context-set-candidate-op-count! pc 0)
  129.     (generic-context-set-converting! pc #f)
  130.     (generic-context-set-multi-cand-input! pc #f)
  131.     (generic-context-set-cands! pc '())
  132.     (rk-flush (generic-context-rk-context pc))))
  133.  
  134. (define generic-update-preedit
  135.   (lambda (pc)
  136.     (if (generic-context-raw-commit pc)
  137.     (generic-context-set-raw-commit! pc #f)
  138.     (let* ((rkc (generic-context-rk-context pc))
  139.            (cands (generic-context-cands pc))
  140.            (n (generic-context-rk-nth pc)))
  141.       (im-clear-preedit pc)
  142.       (im-pushback-preedit
  143.        pc preedit-reverse
  144.        (if (not (null? cands))
  145.            (nth n cands)
  146.            (rk-pending rkc)))
  147.       (im-update-preedit pc)))))
  148.  
  149. (define generic-commit-raw
  150.   (lambda (pc)
  151.     (im-commit-raw pc)
  152.     (generic-context-set-raw-commit! pc #t)))
  153.  
  154. (define generic-commit
  155.   (lambda (pc)
  156.     (let* ((rkc (generic-context-rk-context pc))
  157.        (cands (generic-context-cands pc)))
  158.       (if (not (null? cands))
  159.       (begin
  160.         (im-commit pc (nth (generic-context-rk-nth pc) cands))
  161.         (im-deactivate-candidate-selector pc)
  162.         (generic-context-flush pc))
  163.       (begin
  164.         (im-commit-raw pc)
  165.         (rk-flush rkc))))))
  166.  
  167. (define generic-commit-by-numkey
  168.   (lambda (pc key)
  169.     (let* ((rkc (generic-context-rk-context pc))
  170.        (cands (generic-context-cands pc))
  171.        (n (generic-context-rk-nth pc))
  172.        (nr (length cands))
  173.        (cur-page (if (= generic-nr-candidate-max 0)
  174.              0
  175.              (quotient n generic-nr-candidate-max)))
  176.        (pageidx (- (numeric-ichar->integer key) 1))
  177.        (compensated-pageidx (cond
  178.                  ((< pageidx 0) ; pressing key_0
  179.                   (+ pageidx 10))
  180.                  (else
  181.                   pageidx)))
  182.        (idx (+ (* cur-page generic-nr-candidate-max) compensated-pageidx)))
  183.       (if (< idx nr)
  184.       (begin
  185.         (im-commit pc (nth idx cands))
  186.         (im-deactivate-candidate-selector pc)
  187.         (generic-context-flush pc)
  188.         #t)
  189.       #f))))
  190.  
  191. (define generic-proc-input-state-without-preedit
  192.   (lambda (pc key state rkc)
  193.     (cond
  194.      ((generic-off-key? key state)
  195.       (generic-context-set-on! pc #f)
  196.       #f)
  197.      ((generic-backspace-key? key state)
  198.       (generic-commit-raw pc)
  199.       #f)
  200.      ((symbol? key)
  201.       (generic-commit-raw pc)
  202.       #f)
  203.      ((and (modifier-key-mask state)
  204.        (not (shift-key-mask state)))
  205.       (generic-commit-raw pc)
  206.       #f)
  207.      (else
  208.       #t))))
  209.  
  210. (define generic-proc-input-state-with-preedit
  211.   (lambda (pc key state rkc)
  212.     (cond
  213.      ((generic-off-key? key state)
  214.       (let ((cands (generic-context-cands pc)))
  215.     (if (not (null? cands))
  216.         (begin
  217.           (im-commit pc (nth (generic-context-rk-nth pc) cands))
  218.           (generic-context-flush pc))
  219.         (if (not (string=? (rk-pending rkc) "")) ;; flush pending rk
  220.         (generic-context-flush pc)))
  221.     (generic-context-set-on! pc #f)
  222.     #f))
  223.      ((generic-prev-candidate-key? key state)
  224.       (generic-context-set-converting! pc #t)
  225.       (generic-proc-converting-state pc key state)
  226.       #f)
  227.      ((generic-next-candidate-key? key state)
  228.       (generic-context-set-converting! pc #t)
  229.       (generic-proc-converting-state pc key state)
  230.       #f)
  231.      ((generic-backspace-key? key state)
  232.       (rk-backspace rkc)
  233.       (generic-context-set-rk-nth! pc 0)
  234.       (generic-update-input-state-cands pc key state
  235.                     rkc (rk-context-seq rkc) #f)
  236.       #f)
  237.      ((generic-commit-key? key state)
  238.       (generic-commit pc)
  239.       #f)
  240.      ((generic-cancel-key? key state)
  241.       (generic-context-flush pc)
  242.       #f)
  243.      ((symbol? key)
  244.       (generic-commit pc)
  245.       (im-commit-raw pc)
  246.       #f)
  247.      ((and (modifier-key-mask state)
  248.        (not (shift-key-mask state)))
  249.       (generic-commit pc)
  250.       (im-commit-raw pc)
  251.       #f)
  252.      (else
  253.       #t))))
  254.  
  255. (define generic-update-input-state-cands
  256.   (lambda (pc key state rkc prev-seq res)
  257.     (let* ((cs (rk-current-seq rkc))
  258.        (cands (if cs (cadr cs) '())))
  259.       (generic-context-set-cands! pc cands)
  260.       (if (not (rk-partial? rkc)) ;; exact match or no-match
  261.       (begin
  262.         (if cs
  263.         (if (null? (cdr cands)) 
  264.             ;; single candidate
  265.             (begin
  266.               (im-commit pc
  267.                  (nth (generic-context-rk-nth pc) cands))
  268.               (generic-context-flush pc)
  269.               (im-deactivate-candidate-selector pc))
  270.             ;; show candidates for the Pinyin like input method
  271.             (if (and generic-use-candidate-window?
  272.                  generic-show-candidate-implicitly?)
  273.             (begin
  274.               (im-activate-candidate-selector
  275.                pc (length cands) generic-nr-candidate-max)
  276.               (im-select-candidate pc 0)
  277.               (generic-context-set-converting! pc #t)
  278.               (generic-context-set-candidate-op-count!
  279.                pc
  280.                (+ 1 (generic-context-candidate-op-count pc)))))))
  281.         ;; commit no-matching key
  282.         (if (and
  283.          (not cs)
  284.          (null? (rk-context-seq rkc))
  285.          (or
  286.           (null? prev-seq)
  287.           res)
  288.          (not (generic-backspace-key? key state))) ;; mmm...
  289.         (im-commit-raw pc)))
  290.       ;; partial match
  291.       (begin
  292.         (if cs
  293.         (if (not (null? (cdr cands)))
  294.             ;; show candidates even in input-state
  295.             (begin
  296.               (if (and generic-use-candidate-window?
  297.                    generic-show-candidate-implicitly?)
  298.               (begin
  299.                 (im-activate-candidate-selector
  300.                  pc (length cands) generic-nr-candidate-max)
  301.                 (im-select-candidate pc 0)
  302.                 (generic-context-set-candidate-op-count!
  303.                  pc (+ 1 (generic-context-candidate-op-count pc)))
  304.                 (generic-context-set-multi-cand-input! pc #t)
  305.                 ))))))))))
  306.  
  307. (define generic-proc-input-state
  308.   (lambda (pc key state)
  309.     (let* ((rkc (generic-context-rk-context pc))
  310.            (seq (rk-context-seq rkc))
  311.        (res #f))
  312.       (and
  313.        (if (string=? (rk-pending rkc) "")
  314.        (generic-proc-input-state-without-preedit pc key state rkc)
  315.        (generic-proc-input-state-with-preedit pc key state rkc))
  316.        (begin
  317.      (set! res
  318.            (rk-push-key!
  319.         rkc
  320.         (charcode->string key)))
  321.          (if res
  322.          (begin
  323.            (im-commit pc (nth (generic-context-rk-nth pc) res))
  324.            (generic-context-set-rk-nth! pc 0)
  325.            (generic-context-set-candidate-op-count! pc 0)
  326.            (generic-context-set-cands! pc '())
  327.            (im-deactivate-candidate-selector pc)))
  328.      (generic-update-input-state-cands pc key state rkc seq res))))))
  329.  
  330. (define generic-proc-specific-multi-cand-input-state
  331.   (lambda (pc key state rkc)
  332.     (cond
  333.      ((generic-off-key? key state)
  334.       (let ((cands (generic-context-cands pc)))
  335.     (if (not (null? cands))
  336.         (begin
  337.           (im-commit pc (nth (generic-context-rk-nth pc) cands))
  338.           (generic-context-flush pc))
  339.         (if (not (string=? (rk-pending rkc) "")) ;; flush pending rk
  340.         (generic-context-flush pc)))
  341.     (generic-context-set-on! pc #f)
  342.     (im-deactivate-candidate-selector pc)
  343.     #f))
  344.      ((generic-prev-candidate-key? key state)
  345.       (generic-context-set-converting! pc #t)
  346.       (generic-context-set-multi-cand-input! pc #f)
  347.       (generic-proc-converting-state pc key state)
  348.       #f)
  349.      ((generic-next-candidate-key? key state)
  350.       (generic-context-set-converting! pc #t)
  351.       (generic-context-set-multi-cand-input! pc #f)
  352.       (generic-proc-converting-state pc key state)
  353.       #f)
  354.      ((generic-prev-page-key? key state)
  355.       (generic-context-set-converting! pc #t)
  356.       (generic-context-set-multi-cand-input! pc #f)
  357.       (generic-proc-converting-state pc key state)
  358.       #f)
  359.      ((generic-next-page-key? key state)
  360.       (generic-context-set-converting! pc #t)
  361.       (generic-context-set-multi-cand-input! pc #f)
  362.       (im-shift-page-candidate pc #t)
  363.       #f)
  364.      ((generic-backspace-key? key state)
  365.       (rk-backspace rkc)
  366.       (generic-context-set-rk-nth! pc 0)
  367.       (generic-update-multi-cand-state-cands pc key state
  368.                          rkc (rk-context-seq rkc) #f)
  369.       #f)
  370.      ((generic-commit-key? key state)
  371.       (generic-context-set-multi-cand-input! pc #f)
  372.       (generic-commit pc)
  373.       #f)
  374.      ((generic-cancel-key? key state)
  375.       (im-deactivate-candidate-selector pc)
  376.       (generic-context-flush pc)
  377.       #f)
  378.      ((symbol? key)
  379.       (generic-context-set-multi-cand-input! pc #f)
  380.       (generic-commit pc)
  381.       (im-commit-raw pc)
  382.       #f)
  383.      ((and generic-commit-candidate-by-numeral-key?
  384.        (ichar-numeric? key))
  385.       (if (generic-commit-by-numkey pc key)
  386.       (generic-context-set-multi-cand-input! pc #f))
  387.       #f)
  388.  
  389.      ((and (modifier-key-mask state)
  390.        (not (shift-key-mask state)))
  391.       (generic-context-set-multi-cand-input! pc #f)
  392.       (generic-commit pc)
  393.       (im-commit-raw pc)
  394.       #f)
  395.      (else
  396.       #t))))
  397.  
  398. (define generic-update-multi-cand-state-cands
  399.   (lambda (pc key state rkc prev-seq res)
  400.     (let* ((cs (rk-current-seq rkc))
  401.        (cands (if cs (cadr cs) '())))
  402.       (generic-context-set-cands! pc cands)
  403.       (if (not (rk-partial? rkc)) ;; exact match or no-match
  404.       (begin
  405.         (if cs
  406.         (if (null? (cdr cands))
  407.             (begin
  408.               (im-commit pc
  409.                  (nth (generic-context-rk-nth pc) cands))
  410.               (generic-context-flush pc)
  411.               (im-deactivate-candidate-selector pc))
  412.             ;; show candidates for the Pinyin like input method
  413.             (if (and
  414.              generic-use-candidate-window?
  415.              generic-show-candidate-implicitly?)
  416.             (begin
  417.               (im-activate-candidate-selector
  418.                pc (length cands) generic-nr-candidate-max)
  419.               (im-select-candidate pc 0)
  420.               (generic-context-set-converting! pc #t)))))
  421.         ;; commit no-matching key (backspace only)
  422.         (if (and
  423.          (not cs)
  424.          (null? (rk-context-seq rkc))
  425.          (or
  426.           (null? prev-seq)
  427.           res)
  428.          (generic-backspace-key? key state))
  429.         (begin
  430.           (im-deactivate-candidate-selector pc)
  431.           (generic-context-set-candidate-op-count! pc 0)
  432.           (generic-context-set-multi-cand-input! pc #f))))
  433.       ;; partial match
  434.       (begin
  435.         (if cs
  436.         (if (not (null? (cdr cands)))
  437.             (begin
  438.               (im-activate-candidate-selector
  439.                pc (length cands) generic-nr-candidate-max)
  440.               (im-select-candidate pc 0))
  441.             ;; single candidate
  442.             (begin
  443.               (im-deactivate-candidate-selector pc)
  444.               (generic-context-set-candidate-op-count! pc 0)
  445.               (generic-context-set-multi-cand-input! pc #f)))
  446.         ;; no-candidate
  447.         (begin
  448.           (im-deactivate-candidate-selector pc)
  449.           (generic-context-set-candidate-op-count! pc 0)
  450.           (generic-context-set-multi-cand-input! pc #f))))))))
  451.  
  452. (define generic-proc-multi-cand-input-state
  453.   (lambda (pc key state)
  454.     (let* ((rkc (generic-context-rk-context pc))
  455.            (seq (rk-context-seq rkc))
  456.        (res #f))
  457.       (and
  458.        (generic-proc-specific-multi-cand-input-state pc key state rkc)
  459.        (begin
  460.      (set! res
  461.            (rk-push-key!
  462.         rkc
  463.         (charcode->string key)))
  464.          (if res
  465.          ;; commit matched word and continue new rk
  466.          (begin
  467.            (im-commit pc (nth (generic-context-rk-nth pc) res))
  468.            (generic-context-set-rk-nth! pc 0)
  469.            (generic-context-set-candidate-op-count! pc 0)
  470.            (im-deactivate-candidate-selector pc)
  471.            (generic-context-set-multi-cand-input! pc #f)))
  472.      (generic-update-multi-cand-state-cands pc key state rkc seq res))))))
  473.  
  474. (define generic-proc-converting-state
  475.   (lambda (pc key state)
  476.     (let* ((rkc (generic-context-rk-context pc))
  477.        (n (generic-context-rk-nth pc))
  478.        (cands (generic-context-cands pc))
  479.        (nr (length cands)))
  480.       (and
  481.        (if (generic-prev-candidate-key? key state)
  482.        (if (not (null? cands))
  483.          (if (pair? (cdr cands))
  484.            ;; multiple candidates
  485.            (begin
  486.          (set! n (- n 1))
  487.          (generic-context-set-rk-nth! pc n)
  488.          (if (< n 0)
  489.              (begin
  490.                (generic-context-set-rk-nth! pc (- nr 1))
  491.                (set! n (- nr 1))))
  492.          (generic-context-set-candidate-op-count!
  493.           pc
  494.           (+ 1 (generic-context-candidate-op-count pc)))
  495.          (if (and
  496.                       (= (generic-context-candidate-op-count pc)
  497.                          generic-candidate-op-count)
  498.                       generic-use-candidate-window?)
  499.                      (im-activate-candidate-selector
  500.               pc nr generic-nr-candidate-max))
  501.          (if (and
  502.               (>= (generic-context-candidate-op-count pc)
  503.               generic-candidate-op-count)
  504.                       generic-use-candidate-window?)
  505.              (im-select-candidate pc n))
  506.          #f)
  507.            ;; single candidate
  508.            (begin
  509.          (generic-commit pc)
  510.          #f))
  511.          ;; no candidate
  512.          (begin
  513.            (generic-context-flush pc)
  514.            #f))
  515.        #t)
  516.        (if (generic-next-candidate-key? key state)
  517.        (if (not (null? cands))
  518.          (if (pair? (cdr cands))
  519.            ;; multiple candidates
  520.            (begin
  521.          (generic-context-set-rk-nth! pc (+ 1 n))
  522.          (if (<= nr (+ n 1))
  523.              (generic-context-set-rk-nth! pc 0))
  524.          (generic-context-set-candidate-op-count!
  525.           pc
  526.           (+ 1 (generic-context-candidate-op-count pc)))
  527.          (if (and
  528.               (= (generic-context-candidate-op-count pc)
  529.              generic-candidate-op-count)
  530.               generic-use-candidate-window?)
  531.              (im-activate-candidate-selector pc nr
  532.                              generic-nr-candidate-max))
  533.          (if (and
  534.               (>= (generic-context-candidate-op-count pc)
  535.               generic-candidate-op-count)
  536.               generic-use-candidate-window?)
  537.              (begin
  538.                (if (>= (+ n 1) nr)
  539.                (set! n -1))
  540.                (im-select-candidate pc (+ n 1))))
  541.          #f)
  542.            ;; single candidate
  543.            (begin
  544.          (generic-commit pc)
  545.          #f))
  546.          ;; no candidate
  547.          (begin
  548.            (generic-context-flush pc)
  549.            #f))
  550.        #t)
  551.        (if (and (generic-prev-page-key? key state)
  552.         (<= generic-candidate-op-count
  553.             (generic-context-candidate-op-count pc))
  554.         generic-use-candidate-window?)
  555.        (begin
  556.          (im-shift-page-candidate pc #f)
  557.          #f)
  558.        #t)
  559.        (if (and (generic-next-page-key? key state)
  560.         (<= generic-candidate-op-count
  561.             (generic-context-candidate-op-count pc))
  562.         generic-use-candidate-window?)
  563.        (begin
  564.          (im-shift-page-candidate pc #t)
  565.          #f)
  566.        #t)
  567.        (if (generic-backspace-key? key state)
  568.        (begin
  569.          (if (not (rk-backspace rkc))
  570.          (generic-commit-raw pc))
  571.          (generic-context-set-rk-nth! pc 0)
  572.          (im-deactivate-candidate-selector pc)
  573.          (generic-context-set-candidate-op-count! pc 0)
  574.          (generic-context-set-converting! pc #f)
  575.          (generic-update-input-state-cands pc key state
  576.                            rkc (rk-context-seq rkc) #f)
  577.          #f)
  578.        #t)
  579.        (if (generic-commit-key? key state)
  580.        (begin
  581.          (generic-commit pc)
  582.          #f)
  583.        #t)
  584.        (if (generic-cancel-key? key state)
  585.        (begin
  586.          (generic-context-flush pc)
  587.          (im-deactivate-candidate-selector pc)
  588.          #f)
  589.        #t)
  590.        (if (symbol? key)
  591.        (begin
  592.          (generic-commit pc)
  593.          (im-commit-raw pc)
  594.          #f)
  595.        #t)
  596.        (if (and generic-commit-candidate-by-numeral-key?
  597.         (ichar-numeric? key))
  598.        (begin
  599.          (generic-commit-by-numkey pc key)
  600.          #f)
  601.        #t)
  602.        (if (and (modifier-key-mask state)
  603.         (not (shift-key-mask state)))
  604.        (begin
  605.          (generic-commit pc)
  606.          (im-commit-raw pc)
  607.          #f)
  608.        #t)
  609.        (begin
  610.      (if (not (null? cands))
  611.          (im-commit pc
  612.             (nth (generic-context-rk-nth pc) cands)))
  613.      (generic-context-flush pc)
  614.      (im-deactivate-candidate-selector pc)
  615.      (generic-proc-input-state pc key state))))))
  616.  
  617.  
  618. (define generic-proc-off-mode
  619.   (lambda (pc key state)
  620.     (and
  621.      (if (generic-on-key? key state)
  622.      (begin
  623.        (generic-context-set-on! pc #t)
  624.        #f)
  625.      #t)
  626.      ;;
  627.      (generic-commit-raw pc))))
  628.  
  629. (define generic-key-press-handler
  630.   (lambda (pc key state)
  631.     (if (ichar-control? key)
  632.     (im-commit-raw pc)
  633.     (if (generic-context-on pc)
  634.         (if (generic-context-converting pc)
  635.         (generic-proc-converting-state pc key state)
  636.         (if (generic-context-multi-cand-input pc)
  637.             (generic-proc-multi-cand-input-state pc key state)
  638.             (generic-proc-input-state pc key state)))
  639.         (generic-proc-off-mode pc key state)))
  640.     (generic-update-preedit pc)
  641.     ()))
  642.  
  643. (define generic-key-release-handler
  644.   (lambda (pc key state)
  645.     (if (or (ichar-control? key)
  646.         (not (generic-context-on pc)))
  647.     ;; don't discard key release event for apps
  648.     (generic-commit-raw pc))))
  649.  
  650. (define generic-reset-handler
  651.   (lambda (pc)
  652.     (let ((rkc (generic-context-rk-context pc)))
  653.       (rk-flush rkc))))
  654.  
  655. (define generic-focus-in-handler
  656.   (lambda (pc)
  657.     #f))
  658.  
  659. (define generic-focus-out-handler
  660.   (lambda (pc)
  661.     (let ((rkc (generic-context-rk-context pc))
  662.       (cands (generic-context-cands pc)))
  663.       (cond
  664.        ((not (null? cands)) ;; commit
  665.     (im-commit pc (nth (generic-context-rk-nth pc) cands))
  666.     (im-deactivate-candidate-selector pc)
  667.     (generic-context-flush pc)
  668.     (generic-update-preedit pc))
  669.        ((not (string=? (rk-pending rkc) "")) ;; flush pending rk
  670.     (generic-context-flush pc)
  671.     (generic-update-preedit pc))))))
  672.  
  673. (define generic-place-handler generic-focus-in-handler)
  674. (define generic-displace-handler generic-focus-out-handler)
  675.  
  676. (define generic-get-candidate-handler
  677.   (lambda (pc idx accel-enum-hint)
  678.     (let* ((cands (generic-context-cands pc))
  679.        (cand (nth idx cands)))
  680.       (list cand (digit->string (+ idx 1)) ""))))
  681.  
  682. (define generic-set-candidate-index-handler
  683.   (lambda (pc idx)
  684.     (let ((rkc (generic-context-rk-context pc)))
  685.       (generic-context-set-rk-nth! pc idx)
  686.       (generic-update-preedit pc))))
  687.  
  688. (define generic-init-handler
  689.   (lambda (id im init-handler)
  690.     (init-handler id im #f)))
  691.  
  692. (define generic-register-im
  693.   (lambda (name lang code name-label short-desc init-arg)
  694.     (register-im
  695.      name
  696.      lang
  697.      code
  698.      name-label
  699.      short-desc
  700.      init-arg
  701.      generic-init-handler
  702.      #f  ;; release-handler
  703.      context-mode-handler
  704.      generic-key-press-handler
  705.      generic-key-release-handler
  706.      generic-reset-handler
  707.      generic-get-candidate-handler
  708.      generic-set-candidate-index-handler
  709.      context-prop-activate-handler
  710.      #f
  711.      generic-focus-in-handler
  712.      generic-focus-out-handler
  713.      generic-place-handler
  714.      generic-displace-handler
  715.      )))
  716.  
  717. (generic-configure-widgets)
  718.